home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue24 / ntserv / MakeMiC.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-07-04  |  8.7 KB  |  248 lines
  1. unit MAKEMIC;
  2.  
  3. { This unit defines the MakeMethodInstance,MakeMethodInstance32Reg and         }
  4. { FreeMethodInstance functions. $IFDEFs are used to tailor the unit to the     }
  5. { different versions of Delphi.                                                }
  6.  
  7. interface
  8.  
  9. uses WinTypes, WinProcs, SysUtils;
  10.  
  11. procedure FreeMethodInstance(Instance: Pointer);
  12. function MakeMethodInstance(Code,Data: Pointer): Pointer;
  13. {$IFDEF WIN32}
  14. function MakeMethodInstance32Reg(Code,Data: Pointer; OptCount: Integer): Pointer;
  15. {$ENDIF}
  16.  
  17. implementation
  18.  
  19. type
  20.   PJumpBlock = ^TJumpBlock;
  21.   TJumpBlock = packed record
  22. {$IFDEF WIN32}
  23.     POP_EAX_OpCode: Byte;
  24.     Push_Immed_OpCode: Byte;
  25.     Self_Value: Pointer;
  26.     PUSH_EAX_OpCode: Byte;
  27.     Jmp_OpCode: Byte;
  28.     Method_Addr: Pointer;
  29.     DummyAddr: Byte;
  30. {$ELSE}
  31.     POP_AX_OpCode: Byte;
  32.     POP_CX_OpCode: Byte;
  33.     Push_Seg_Immed_OpCode: Byte;
  34.     Self_Seg_Value: Word;
  35.     Push_Ofs_Immed_OpCode: Byte;
  36.     Self_Ofs_Value: Word;
  37.     PUSH_CX_OpCode: Byte;
  38.     PUSH_AX_OpCode: Byte;
  39.     Jmp_OpCode: Byte;
  40.     Method_Addr: Pointer;
  41.     { Specific information needed for 16 bit segmented memory }
  42.     DataSelector: THandle;
  43.     CodeSelector: THandle;
  44. {$ENDIF}
  45.   end;
  46.  
  47. function MakeMethodInstance(Code,Data: Pointer): Pointer;
  48. {$IFNDEF WIN32}
  49. var
  50.   WrkHData,WrkHCode: THandle;
  51. {$ENDIF}
  52.  
  53. begin
  54. {$IFDEF WIN32}
  55.   Result := VirtualAlloc(nil,sizeof(TJumpBlock),MEM_COMMIT,PAGE_EXECUTE_READWRITE);
  56.   if Result <> nil then
  57.     With PJumpBlock(Result)^ do
  58.       begin
  59.         POP_EAX_OpCode    := $58;    { POP Return address into EAX register }
  60.         Push_Immed_OpCode := $68;    { PUSH DWORD following this instruction }
  61.         Self_Value        := Data;   { Set DWORD to the object instance address }
  62.         PUSH_EAX_OpCode   := $50;    { Push the return address back on the stack }
  63.         Jmp_OpCode        := $E9;    { JMP to the relative offset following this opcode }
  64.         Method_Addr       := Pointer(LongInt(Code) - LongInt(@DummyAddr));
  65.       end;
  66. {$ELSE}
  67.   WrkHData := GlobalAlloc(HeapAllocFlags,SizeOf(TJumpBlock));
  68.   Result := GlobalLock(WrkHData);
  69.   if Result <> nil then
  70.     With PJumpBlock(Result)^ do
  71.       begin
  72.         POP_AX_OpCode         := $58;    { POP Return address into EAX register }
  73.         POP_CX_OpCode         := $59;    { POP Return address into ECX register }
  74.         Push_Seg_Immed_OpCode := $68;    { PUSH the Self segment value onto stack }
  75.         Self_Seg_Value        := PtrRec(Data).Seg;
  76.         Push_Ofs_Immed_OpCode := $68;    { PUSH the Self segment offset onto stack }
  77.         Self_Ofs_Value        := PtrRec(Data).Ofs;
  78.         PUSH_CX_OpCode        := $51;    { PUSH the CX register back onto the stack }
  79.         PUSH_AX_OpCode        := $50;    { PUSH the AX register back onto the stack }
  80.         Jmp_OpCode            := $EA;    { JMP to the address following this opcode }
  81.         Method_Addr           := Code;
  82.         WrkHCode              := AllocDsToCSAlias(PtrRec(Result).Seg);
  83.         PtrRec(Result).Seg    := WrkHCode;
  84.         { Store the code and data selectors for FreeMethodInstance }
  85.         DataSelector          := WrkHData;
  86.         CodeSelector          := WrkHCode;
  87.       end;
  88. {$ENDIF}
  89. end;
  90.  
  91. procedure FreeMethodInstance(Instance: Pointer);
  92. {$IFNDEF WIN32}
  93. var
  94.   WrkHData,WrkHCode: THandle;
  95. {$ENDIF}
  96.  
  97. begin
  98. {$IFDEF WIN32}
  99.   if Instance <> nil then
  100.     VirtualFree(Instance,0,MEM_DECOMMIT);
  101. {$ELSE}
  102.   if Instance <> nil then
  103.     With PJumpBlock(Instance)^ do
  104.       begin
  105.         WrkHData := DataSelector;
  106.         WrkHCode := CodeSelector;
  107.         GlobalUnlock(WrkHData);
  108.         GlobalFree(WrkHData);
  109.         FreeSelector(WrkHCode);
  110.       end;
  111. {$ENDIF}
  112. end;
  113.  
  114. {==============================================================================}
  115. { All code following this comment is only available in Delphi 2                }
  116. {==============================================================================}
  117.  
  118. {$IFDEF WIN32}
  119. type
  120.   PJumpBlockOpt0 = ^TJumpBlockOpt0;
  121.   TJumpBlockOpt0 = packed record
  122.     MOV_EAX_Immed_OpCode: Byte;
  123.     Self_Value: Pointer;
  124.     Jmp_OpCode: Byte;
  125.     Method_Addr: Pointer;
  126.     DummyAddr: Byte;
  127.   end;
  128.  
  129. type
  130.   PJumpBlockOpt1 = ^TJumpBlockOpt1;
  131.   TJumpBlockOpt1 = packed record
  132.     MOV_EAX_2_EDX_OpCode: Word;
  133.     MOV_EAX_Immed_OpCode: Byte;
  134.     Self_Value: Pointer;
  135.     Jmp_OpCode: Byte;
  136.     Method_Addr: Pointer;
  137.     DummyAddr: Byte;
  138.   end;
  139.  
  140. type
  141.   PJumpBlockOpt2 = ^TJumpBlockOpt2;
  142.   TJumpBlockOpt2 = packed record
  143.     MOV_EDX_2_ECX_OpCode: Word;
  144.     MOV_EAX_2_EDX_OpCode: Word;
  145.     MOV_EAX_Immed_OpCode: Byte;
  146.     Self_Value: Pointer;
  147.     Jmp_OpCode: Byte;
  148.     Method_Addr: Pointer;
  149.     DummyAddr: Byte;
  150.   end;
  151.  
  152. type
  153.   PJumpBlockOpt3 = ^TJumpBlockOpt3;
  154.   TJumpBlockOpt3 = packed record
  155.     MOV_ECX_2_ParmStore_OpCode: Word;
  156.     Parm3_Store_Address: Pointer;
  157.     POP_ECX_OpCode: Byte;
  158.     MOV_ECX_2_RetAddrStore_OpCode: Word;
  159.     RetAddr_Store_Address: Pointer;
  160.     MOV_EDX_2_ECX_OpCode: Word;
  161.     MOV_EAX_2_EDX_OpCode: Word;
  162.     MOV_ParmStore_2_EAX_OpCode: Byte;
  163.     Parm3_Store_Address2: Pointer;
  164.     PUSH_Parm3_From_EAX_OpCode: Byte;
  165.     MOV_RetAddr_2_EAX_OpCode: Byte;
  166.     RetAddr_Store_Address2: Pointer;
  167.     PUSH_RetAddr_From_EAX_OpCode: Byte;
  168.     MOV_EAX_Immed_OpCode: Byte;
  169.     Self_Value: Pointer;
  170.     Jmp_OpCode: Byte;
  171.     Method_Addr: Pointer;
  172.     DummyAddr: Byte;
  173.     { Temp storage areas for 3rd parameter and return address }
  174.     Temp_Parm3_Store: Pointer;
  175.     Temp_ReturnAddr_Store: Pointer;
  176.   end;
  177.  
  178. function MakeMethodInstance32Reg(Code,Data: Pointer; OptCount: Integer): Pointer;
  179. begin
  180.   Result := nil;
  181.   if OptCount in [0..3] then
  182.     begin
  183.       Result := VirtualAlloc(nil,sizeof(TJumpBlockOpt3),MEM_COMMIT,PAGE_EXECUTE_READWRITE);
  184.       if Result <> nil then
  185.         case OptCount of
  186.           0:
  187.  
  188.             With PJumpBlockOpt0(Result)^ do
  189.               begin
  190.                 MOV_EAX_Immed_OpCode := $B8;    { Move DWORD following this instruction into EAX register }
  191.                 Self_Value           := Data;   { Set DWORD to the object instance address }
  192.                 Jmp_OpCode           := $E9;    { JMP to the relative offset following this opcode }
  193.                 Method_Addr          := Pointer(LongInt(Code) - LongInt(@DummyAddr));
  194.               end;
  195.  
  196.           1:
  197.  
  198.             With PJumpBlockOpt1(Result)^ do
  199.               begin
  200.                 MOV_EAX_2_EDX_OpCode := $D08B;  { Copy EAX register to the EDX register }
  201.                 MOV_EAX_Immed_OpCode := $B8;    { Move DWORD following this instruction into EAX register }
  202.                 Self_Value           := Data;   { Set DWORD to the object instance address }
  203.                 Jmp_OpCode           := $E9;    { JMP to the relative offset following this opcode }
  204.                 Method_Addr          := Pointer(LongInt(Code) - LongInt(@DummyAddr));
  205.               end;
  206.  
  207.           2:
  208.  
  209.             With PJumpBlockOpt2(Result)^ do
  210.               begin
  211.                 MOV_EDX_2_ECX_OpCode := $CA8B;  { Copy EDX register to ECX register }
  212.                 MOV_EAX_2_EDX_OpCode := $D08B;  { Copy EAX register to the EDX register }
  213.                 MOV_EAX_Immed_OpCode := $B8;    { Move DWORD following this instruction into EAX register }
  214.                 Self_Value           := Data;   { Set DWORD to the object instance address }
  215.                 Jmp_OpCode           := $E9;    { JMP to the relative offset following this opcode }
  216.                 Method_Addr          := Pointer(LongInt(Code) - LongInt(@DummyAddr));
  217.               end;
  218.  
  219.           3:
  220.  
  221.             With PJumpBlockOpt3(Result)^ do
  222.               begin
  223.                 MOV_ECX_2_ParmStore_OpCode := $0D89;
  224.                 Parm3_Store_Address := @Temp_Parm3_Store;
  225.                 POP_ECX_OpCode := $59;
  226.                 MOV_ECX_2_RetAddrStore_OpCode := $0D89;
  227.                 RetAddr_Store_Address := @Temp_ReturnAddr_Store;
  228.                 MOV_EDX_2_ECX_OpCode := $CA8B;
  229.                 MOV_EAX_2_EDX_OpCode := $D08B;
  230.                 MOV_ParmStore_2_EAX_OpCode := $A1;
  231.                 Parm3_Store_Address2 := @Temp_Parm3_Store;
  232.                 PUSH_Parm3_From_EAX_OpCode := $50;
  233.                 MOV_RetAddr_2_EAX_OpCode := $A1;
  234.                 RetAddr_Store_Address2 := @Temp_ReturnAddr_Store;
  235.                 PUSH_RetAddr_From_EAX_OpCode := $50;
  236.                 MOV_EAX_Immed_OpCode   := $B8;  { Move DWORD following this instruction into EAX register }
  237.                 Self_Value             := Data; { Set DWORD to the object instance address }
  238.                 Jmp_OpCode             := $E9;  { JMP to the relative offset following this opcode }
  239.                 Method_Addr            := Pointer(LongInt(Code) - LongInt(@DummyAddr));
  240.               end;
  241.         end;
  242.     end;
  243. end;
  244.  
  245. {$ENDIF}
  246.  
  247. end.
  248.